#/usr/bin/perl 
#===============================================================================
#
#         FILE:  ex.pl
#
#        USAGE:  ./ex.pl  
#
#  DESCRIPTION:  
#
#      OPTIONS:  ---
# REQUIREMENTS:  ---
#         BUGS:  ---
#        NOTES:  ---
#       AUTHOR:  Dr. Fritz Mehner (mn), mehner@fh-swf.de
#      COMPANY:  FH Südwestfalen, Iserlohn
#      VERSION:  1.0
#      CREATED:  06/01/11 17:38:33
#     REVISION:  ---
#===============================================================================

#use strict;
#use warnings;


our %hash = (
		"toplevel-0" => "value",
		"toplevel-1" => 
		{ 
			"sublevel1a"  => "value-1a",
			"sublevel1b"  => "value-1b"
		},
		"toplevel-2" =>
		{
			"sublevel1c" => 
			{
				"value-1c.1" => "replacement-1c.1",
				"value-1c.2" => "replacement-1c.2"
			},
			"sublevel1d" => "value-1d"
		}
		);

hashwalk(\%hash , "\$hash");

my $kkk;
$kkk = $hash{"toplevel-2"};
foreach my $key (keys %$kkk){
	print "TT $$kkk{$key}\n";
}

our $kim="AAA  TT";
print "RETURN=" , getvalue("\$kim") , "\n";
print "RETURN=" , getvalue("\$hash{toplevel-0}") , "\n";
print "RETURN=" , getvalue("\$hash{toplevel-2}{sublevel1d}") , "\n";

our %ha;
$ha{abc}[3] = "ha_abc";
$ha{ttt}[2] = "ha_ttt";
$ha{hash}{0}="a";
$ha{hash}{1}="b";
$ha{hash}{2}="c";
$ha{hash}{3}="d";
$ha{hash}{4}="e";
our @ah;
$ah[1]{ttt}="ah_1ttt";
$ah[1]{kkk}="ah_1kkk";
$ah[1]{ppp}="ah_1ppp";
$ah[0]{ttt}="ah_0ttt";

treewalk(\%ha , "\$ha");
treewalk(\@ah , "\$ah");

print "RETURN=" , getvalue("\$ha{abc}") , "\n";
print "RETURN=" , getvalue("\$ha{abc}[3]") , "\n";
print "RETURN=" , getvalue("\$ah[1]") , "\n";
print "RETURN=" , getvalue("\$ah[1]{ttt}") , "\n";

my $list;
$list = getarray_from_var ("\$ah[1]");
print "ref($list} \n";
if(ref($list) eq "HASH"){
	print "ref(=" . $list . "\n";
	foreach my $t (keys %$list){
		print "$t = $$list{$t}\n";
	}
}
$list = getarray_from_var ("\$ha{abc}");
print "ref($list} \n";
if(ref($list) eq "ARRAY"){
	foreach my $t (@$list){
		print "ARRAY $t\n";
	}
}
$list = getarray_from_var ("\$ha{hash}");
print "ref($list} .\n";
$list = getarray_from_var ("\$ha{abc}");
print "ref($list} .\n";

sub getarray_from_var {
	my ($str) = @_;
	my $m;
	my @list;
	my @list_type;
	my $list_cnt=0;
	my @ret;

	($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(0); 
	print "$subroutine : $str\n";
	$str =~ s/\s*\$([^\s\[\{\$]+)\s*//;
	$m = $1;
	while(1){
		if($str =~ s/\s*\{([^\s\}\$]+)\s*\}\s*//){
			$list[$aa_cnt] = $1;
			$list_type[$list_cnt] = "HASH";
		} elsif($str =~ s/\s*\[([^\s\]\$]+)\s*\]\s*//){
			$list[$aa_cnt] = $1;
			$list_type[$list_cnt] = "ARRAY";
		} else {
			last;
		}
		$list_cnt ++;
	}
	print "cnt =$list_cnt , m = $m  , list =@list @list_type\n";

	if($list_cnt == 0){
		print "ERROR : $subroutine : list count is very small. you can get values directly without using this function. \n";
		return $$m;
	}

	my $t = $m;
	print "KK2= $m ref=",ref($$m) ,"\n";
	print "KK3=",$$t{$aa[1]} , "\n";
	print "KK4=",$$m{$aa[0]}{$aa[1]} , "\n";

	my $l_type;
	$t = $m;
	print "II $i =", ref($t) , "\n";
	for(my $i=0;$i<$list_cnt;$i++){
		if($list_type[$i] eq "HASH"){ $t = $$t{$list[$i]}; }
		else { $t = $$t[$list[$i]]; }
		$l_type = ref($t);
		print "II $i=", $l_type , " TT= $t\n";
	}

	return $t;
}


# getvaule 
#  description : we can get hash values from string mode.
#  skill : using reference in perl
#
sub getvalue {
	my ($str) = @_;
	my $m;
	my @aa;
	my $aa_cnt=0;
	($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(0); 
	print "$subroutine $str\n";
	$str =~ s/\$([^\s\{\$]+)\s*//;
	$m = $1;
	while($str =~ s/\s*\{([^\s\}\$]+)\s*\}\s*//){
		$aa[$aa_cnt] = $1;
		$aa_cnt ++;
	}
	print "cnt =$aa_cnt , m = $m $$m\n";

	if($aa_cnt == 0){
		return $$m;
	}

	my $tt = @aa;
	print "m=" , $m , "\@aa=",@aa , "\n", $tt ,"\n";
	print "KK1=",$$m{$aa[0]} , "\n";
	my $t = $$m{$aa[0]};
	print "KK2=",$t , "\n";
	#print "KK3=",$$t{$aa[1]} , "\n";
	#print "KK4=",$$m{$aa[0]}{$aa[1]} , "\n";

	$t = $m;
	print "II $i =", ref($t) , "\n";
	for(my $i=0;$i<$aa_cnt;$i++){
		$t = $$t{$aa[$i]};
		print "II $i=", ref($t) , " TT= $t\n";
	}
	return $t;
}

# hashwalk
#  description : traversing the hash tree
#  skill : using reference in perl
#
sub hashwalk
{
	my ($element,$str) = @_;
	print "HASHWALK : $element\n";
	if( ref($element) =~ /HASH/  ||   $element eq "HASH")
	{
		foreach my $key (keys %$element)
		{
			#print $key," => \n";
			hashwalk($$element{$key} , $str . "{" . $key . "}");
		}
	}
	elsif( ref($element) =~ /ARRAY/ ||   $element eq "ARRAY")
	{
		my $cnt = @$element;
		#print "array size = $cnt\n";
		for(my $i = 0 ; $i<$cnt ; $i++){
			#print $i," => \n";
			hashwalk($$element[$i] , $str . "[" . $i . "]");
		}
	}
	else
	{
		print $element,"\n";
		my $cnt = @$element;
		print "PP " , $str , "=",$element,"cnt= $cnt\n";
	}
};


my $global_print_cnt =0;
sub treewalk
{
	my ($element,$str) = @_;
	print "[$global_print_cnt] TREEWALK : $element , $str\n";
	if( ref($element) =~ /HASH/)
	{
		foreach my $key (keys %$element)
		{
			#print "$str {",$key,"}"," => \n";
			treewalk($$element{$key} , $str . "{" . $key . "}");
		}
	}
	elsif( ref($element) =~ /ARRAY/)
	{
		my $cnt = @$element;
		#print "array size = $cnt\n";
		for(my $i = 0 ; $i<$cnt ; $i++){
			#print "$str [",$i,"]"," => \n";
			treewalk($$element[$i] , $str . "[" . $i . "]");
		}
	}
	else
	{
		$global_print_cnt ++;
		#print $element,"\n";
		my $cnt = @$element;
		print "[$global_print_cnt] >> " , $str , "=",$element,"    \t\t\t\cnt= $cnt  ref=",ref($element),"\n";
	}
};
